home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / ici / ici.cpi / parse.c < prev    next >
C/C++ Source or Header  |  1994-10-27  |  36KB  |  1,767 lines
  1. #include "parse.h"
  2. #include "func.h"
  3. #include "str.h"
  4. #include "struct.h"
  5. #include "buf.h"
  6. #include "file.h"
  7. #include "op.h"
  8. #include "exec.h"
  9.  
  10. static char    not_by[]    = "not followed by";
  11. static char    an_expression[]    = "an expression";
  12.  
  13. STATIC string_t    *string_array;
  14. STATIC string_t    *string_set;
  15. STATIC string_t    *string_struct;
  16. STATIC string_t    *string_func;
  17. STATIC string_t    *string_NULL;
  18. STATIC string_t    *string_in;
  19. STATIC string_t    *string_onerror;
  20. STATIC string_t    *string_else;
  21. STATIC string_t    *string_auto;
  22. STATIC string_t    *string_break;
  23. STATIC string_t    *string_case;
  24. STATIC string_t    *string_continue;
  25. STATIC string_t    *string_default;
  26. STATIC string_t    *string_do;
  27. STATIC string_t    *string_extern;
  28. STATIC string_t    *string_for;
  29. STATIC string_t    *string_forall;
  30. STATIC string_t    *string_if;
  31. STATIC string_t    *string_return;
  32. STATIC string_t    *string_static;
  33. STATIC string_t    *string_switch;
  34. STATIC string_t    *string_while;
  35. STATIC string_t    *string_try;
  36.  
  37.  
  38. /*
  39.  * A few forward definitions...
  40.  */
  41. STATIC int     compound_statement();
  42. STATIC int     expr();
  43. STATIC int     const_expression();
  44. STATIC int    statement();
  45.  
  46. /*
  47.  * In general, parseing functions return -1 on error (and set the global
  48.  * error string), 0 if they encountered an early head symbol conflict (and
  49.  * the parse stream has not been disturbed), and 1 if they actually got
  50.  * what they were looking for.
  51.  */
  52.  
  53. #define    this    p->p_got.t_what
  54.  
  55. #ifndef    SMALL
  56.  
  57. #define    next(p, a)  (p->p_ungot.t_what != T_NONE \
  58.             ? (p->p_got=p->p_ungot, p->p_ungot.t_what=T_NONE, this) \
  59.             : lex(p, a))
  60.  
  61. #define    reject(p) (p->p_ungot = p->p_got)
  62.  
  63. #else
  64.  
  65. STATIC int
  66. next(p, a)
  67. parse_t    *p;
  68. array_t    *a;
  69. {
  70.     if (p->p_ungot.t_what != T_NONE)
  71.     {
  72.     p->p_got = p->p_ungot;
  73.     p->p_ungot.t_what = T_NONE;
  74.     return this;
  75.     }
  76.     return lex(p, a);
  77. }
  78.  
  79. STATIC void
  80. reject(p)
  81. parse_t    *p;
  82. {
  83.     p->p_ungot = p->p_got;
  84. }
  85. #endif
  86.  
  87. int
  88. init_parse()
  89. {
  90. #define STRING(x) if (need_string(&string_ ## x, #x)) return 1
  91.     STRING(array);
  92.     STRING(set);
  93.     STRING(struct);
  94.     STRING(func);
  95.     STRING(NULL);
  96.     STRING(in);
  97.     STRING(onerror);
  98.     STRING(else);
  99.     STRING(auto);
  100.     STRING(break);
  101.     STRING(case);
  102.     STRING(continue);
  103.     STRING(default);
  104.     STRING(do);
  105.     STRING(extern);
  106.     STRING(for);
  107.     STRING(forall);
  108.     STRING(if);
  109.     STRING(return);
  110.     STRING(static);
  111.     STRING(switch);
  112.     STRING(while);
  113.     STRING(try);
  114. #undef STRING
  115.     return 0;
  116. }
  117.  
  118. STATIC int
  119. not_followed_by(a, b)
  120. char    *a;
  121. char    *b;
  122. {
  123.     sprintf(buf, "\"%s\" %s %s", a, not_by, b);
  124.     error = buf;
  125.     return -1;
  126. }
  127.  
  128. /*
  129.  * Returns a non-loose array of identifiers parsed from a comma seperated
  130.  * list, or NULL on error.  The array may be empty.
  131.  */
  132. STATIC array_t *
  133. ident_list(p)
  134. parse_t    *p;
  135. {
  136.     array_t    *a;
  137.  
  138.     a = new_array();
  139.     for (;;)
  140.     {
  141.     if (next(p, NULL) != T_NAME)
  142.     {
  143.         reject(p);
  144.         return a;
  145.     }
  146.     if (pushcheck(a, 1))
  147.         goto fail;
  148.     *a->a_top = p->p_got.t_obj;
  149.     loose(*a->a_top);
  150.     ++a->a_top;
  151.     if (next(p, NULL) != T_COMMA)
  152.     {
  153.         reject(p);
  154.         return a;
  155.     }
  156.     }
  157.  
  158. fail:
  159.     loose(a);
  160.     return NULL;
  161. }
  162.  
  163. /*
  164.  * Return -1, 0 or 1, usual conventions.  On success, returns a parsed
  165.  * non-loose function in parse.p_got.t_obj.
  166.  */
  167. STATIC int
  168. function(p, name)
  169. parse_t        *p;
  170. string_t    *name;
  171. {
  172.     array_t    *a;
  173.     func_t    *f;
  174.     func_t    *saved_func;
  175.     object_t    **fp;
  176.  
  177.     a = NULL;
  178.     f = NULL;
  179.     if (next(p, NULL) != T_ONROUND)
  180.     {
  181.     reject(p);
  182.     return 0;
  183.     }
  184.     if ((a = ident_list(p)) == NULL)
  185.     return -1;
  186.     saved_func = p->p_func;
  187.     if (next(p, NULL) != T_OFFROUND)
  188.     {
  189.     not_followed_by("ident ( [args]", "\")\"");
  190.     goto fail;
  191.     }
  192.     if ((f = new_func()) == NULL)
  193.     goto fail;
  194.     if ((f->f_autos = new_struct()) == NULL)
  195.     goto fail;
  196.     loose(f->f_autos);
  197.     for (fp = a->a_base; fp < a->a_top; ++fp)
  198.     {
  199.     if (assign(f->f_autos, *fp, objof(&o_null)))
  200.         goto fail;
  201.     }
  202.     f->f_autos->s_super = structof(v_top[-1])->s_super;
  203.     p->p_func = f;
  204.     f->f_args = a;
  205.     loose(a);
  206.     a = NULL;
  207.     f->f_name = name;
  208.     if (pushcheck(f->f_args, 1))
  209.     goto fail;
  210.     switch (compound_statement(p, NULL))
  211.     {
  212.     case 0: not_followed_by("ident ( [args] )", "\"{\"");
  213.     case -1: goto fail;
  214.     }
  215.     f->f_code = arrayof(p->p_got.t_obj);
  216.     loose(f->f_code);
  217.     if (pushcheck(f->f_code, 2))
  218.     goto fail;
  219.     *f->f_code->a_top++ = objof(&o_null);
  220.     *f->f_code->a_top++ = objof(&o_return);
  221.     f->f_code = arrayof(atom(objof(f->f_code), 1));
  222.     f->f_args = arrayof(atom(objof(f->f_args), 1));
  223.     f->f_autos = structof(atom(objof(f->f_autos), 1));
  224.     p->p_got.t_obj = atom(objof(f), 1);
  225.     p->p_func = saved_func;
  226.     return 1;
  227.  
  228. fail:
  229.     if (a != NULL)
  230.     loose(a);
  231.     if (f != NULL)
  232.     loose(f);
  233.     p->p_func = saved_func;
  234.     return -1;
  235. }
  236.  
  237. STATIC int
  238. data_def(p, d)
  239. parse_t        *p;
  240. struct_t    *d;    /* The struct the idents are going into. */
  241. {
  242.     object_t    *o;    /* The value it is initialised with. */
  243.     object_t    *n;    /* The name. */
  244.     struct_t    *super;
  245.     int        wasfunc;
  246.     int        hasinit;
  247.  
  248.     n = NULL;
  249.     o = NULL;
  250.     wasfunc = 0;
  251.     /*
  252.      * Work through the list of identifiers being declared.
  253.      */
  254.     for (;;)
  255.     {
  256.     if (next(p, NULL) != T_NAME)
  257.     {
  258.         error = "syntax error in variable definition";
  259.         goto fail;
  260.     }
  261.     n = p->p_got.t_obj;
  262.  
  263.     /*
  264.      * Gather any initialisation or function.
  265.      */
  266.     hasinit = 0;
  267.     switch (next(p, NULL))
  268.     {
  269.     case T_EQ:
  270.         switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
  271.         {
  272.         case 0: not_followed_by("ident =", an_expression);
  273.         case -1: goto fail;
  274.         }
  275.         hasinit = 1;
  276.         break;
  277.  
  278.     case T_ONROUND:
  279.         reject(p);
  280.         if (function(p, stringof(n)) < 0)
  281.         goto fail;
  282.         o = p->p_got.t_obj;
  283.         wasfunc = 1;
  284.         hasinit = 1;
  285.         break;
  286.  
  287.     default:
  288.         o = objof(&o_null);
  289.         got(o);
  290.         reject(p);
  291.     }
  292.  
  293.     /*
  294.      * Assign to the new variable if it doesn't appear to exist
  295.      * or has an explicit initialisation.  But patch out the super
  296.      * of the struct to get an exact hit on the struct in question.
  297.      */
  298.     if ((super = d->s_super) != NULL)
  299.     {
  300.         got(super);
  301.         d->s_super = NULL;
  302.     }
  303.     if (hasinit || fetch(objof(d), n) == objof(&o_null))
  304.     {
  305.         if (assign(objof(d), n, o))
  306.         {
  307.         if ((d->s_super = super) != NULL)
  308.             loose(super);
  309.         goto fail;
  310.         }
  311.     }
  312.     if ((d->s_super = super) != NULL)
  313.         loose(super);
  314.  
  315.     loose(n);
  316.     n = NULL;
  317.     loose(o);
  318.     o = NULL;
  319.  
  320.     if (wasfunc)
  321.         return 1;
  322.  
  323.     switch (next(p, NULL))
  324.     {
  325.     case T_COMMA: continue;
  326.     case T_SEMICOLON: return 1;
  327.     }
  328.     error = "variable definition not followed by \";\" or \",\"";
  329.     goto fail;
  330.     }
  331.  
  332. fail:
  333.     if (n != NULL)
  334.     loose(n);
  335.     if (o != NULL)
  336.     loose(o);
  337.     return -1;
  338. }
  339.  
  340. STATIC int
  341. compound_statement(p, sw)
  342. parse_t        *p;
  343. struct_t    *sw;
  344. {
  345.     array_t    *a;
  346.  
  347.     a = NULL;
  348.     if (next(p, NULL) != T_ONCURLY)
  349.     {
  350.     reject(p);
  351.     return 0;
  352.     }
  353.     ++p->p_depth;
  354.     if ((a = new_array()) == NULL)
  355.     goto fail;
  356.     for (;;)
  357.     {
  358.     switch (statement(p, a, sw, NULL))
  359.     {
  360.     case -1: goto fail;
  361.     case 1: continue;
  362.     }
  363.     break;
  364.     }
  365.     if (next(p, a) != T_OFFCURLY)
  366.     {
  367.     error = "badly formed statement";
  368.     goto fail;
  369.     }
  370.     p->p_got.t_obj = objof(a);
  371.     --p->p_depth;
  372.     return 1;
  373.  
  374. fail:
  375.     if (a != NULL)
  376.     loose(a);
  377.     --p->p_depth;
  378.     return -1;
  379. }
  380.  
  381. STATIC void
  382. free_expr(e)
  383. expr_t    *e;
  384. {
  385.     int    i;
  386.  
  387.     if (e == NULL)
  388.     return;
  389.     for (i = 0; i < nels(e->e_arg); ++i)
  390.     free_expr(e->e_arg[i]);
  391.     if (e->e_obj != NULL)
  392.     loose(e->e_obj);
  393.     zfree((char *)e);
  394. }
  395.  
  396. STATIC int
  397. bracketed_expr(p, ep)
  398. parse_t    *p;
  399. expr_t    **ep;
  400. {
  401.     if (next(p, NULL) != T_ONROUND)
  402.     {
  403.     reject(p);
  404.     return 0;
  405.     }
  406.     switch (expr(p, ep, t_prec(T_COMMA)))
  407.     {
  408.     case 0: not_followed_by("(", an_expression);
  409.     case -1: return -1;
  410.     }
  411.     if (next(p, NULL) != T_OFFROUND)
  412.     return not_followed_by("( expr", "\")\"");
  413.     return 1;
  414. }
  415.  
  416. STATIC int
  417. primary(p, ep)
  418. parse_t    *p;
  419. expr_t    **ep;
  420. {
  421.     expr_t    *e;
  422.     array_t    *a;
  423.     struct_t    *d;
  424.     set_t    *s;
  425.     object_t    *n;
  426.     object_t    *o;
  427.  
  428.     *ep = NULL;
  429.     if ((e = talloc(expr_t)) == NULL)
  430.     return -1;
  431.     e->e_arg[0] = NULL;
  432.     e->e_arg[1] = NULL;
  433.     e->e_obj = NULL;
  434.     switch (next(p, NULL))
  435.     {
  436.     case T_INT:
  437.     e->e_what = T_INT;
  438.     if ((e->e_obj = objof(new_int(p->p_got.t_int))) == NULL)
  439.         goto fail;
  440.     break;
  441.  
  442.     case T_FLOAT:
  443.     e->e_what = T_FLOAT;
  444.     if ((e->e_obj = objof(new_float(p->p_got.t_float))) == NULL)
  445.         goto fail;
  446.     break;
  447.  
  448.     case T_STRING:
  449.     e->e_what = T_STRING;
  450.     o = p->p_got.t_obj;
  451.     while (next(p, NULL) == T_STRING)
  452.     {
  453.         register int    i;
  454.  
  455.         i = stringof(p->p_got.t_obj)->s_nchars;
  456.         if (chkbuf(stringof(o)->s_nchars + i + 1))
  457.         goto fail;
  458.         memcpy(buf, stringof(o)->s_chars, stringof(o)->s_nchars);
  459.         memcpy
  460.         (
  461.         buf + stringof(o)->s_nchars,
  462.         stringof(p->p_got.t_obj)->s_chars,
  463.         i
  464.         );
  465.         i += stringof(o)->s_nchars;
  466.         loose(o);
  467.         loose(p->p_got.t_obj);
  468.         if ((o = objof(new_name(buf, i))) == NULL)
  469.         goto fail;
  470.         this = T_NONE;
  471.     }
  472.     reject(p);
  473.     e->e_obj = o;
  474.     break;
  475.  
  476.     case T_REGEXP:
  477.     e->e_what = T_CONST;
  478.     e->e_obj = p->p_got.t_obj;
  479.     break;
  480.  
  481.     case T_NAME:
  482.     if (p->p_got.t_obj == objof(string_NULL))
  483.     {
  484.         e->e_what = T_NULL;
  485.         loose(p->p_got.t_obj);
  486.         break;
  487.     }
  488.     e->e_what = T_NAME;
  489.     e->e_obj = p->p_got.t_obj;
  490.     break;
  491.  
  492.     case T_ONROUND:
  493.     reject(p);
  494.     zfree((char *)e);
  495.     e = NULL;
  496.     if (bracketed_expr(p, &e) < 1)
  497.         goto fail;
  498.     break;
  499.  
  500.     case T_ONSQUARE:
  501.     if (next(p, NULL) != T_NAME)
  502.     {
  503.         not_followed_by("[", "an identifier");
  504.         goto fail;
  505.     }
  506.     if (p->p_got.t_obj == objof(string_array))
  507.     {
  508.         loose(p->p_got.t_obj);
  509.         this = T_NONE;
  510.         if ((a = new_array()) == NULL)
  511.         goto fail;
  512.         for (;;)
  513.         {
  514.         switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
  515.         {
  516.         case -1: goto fail;
  517.         case 1:
  518.             if (pushcheck(a, 1))
  519.             {
  520.             loose(a);
  521.             goto fail;
  522.             }
  523.             *a->a_top++ = o;
  524.             loose(o);
  525.             if (next(p, NULL) == T_COMMA)
  526.             continue;
  527.             reject(p);
  528.             break;
  529.         }
  530.         break;
  531.         }
  532.         if (next(p, NULL) != T_OFFSQUARE)
  533.         {
  534.         loose(a);
  535.         not_followed_by("[array expr, expr ...", "\"]\"");
  536.         goto fail;
  537.         }
  538.         e->e_what = T_CONST;
  539.         e->e_obj = objof(a);
  540.     }
  541.     else if (p->p_got.t_obj == objof(string_struct))
  542.     {
  543.         struct_t    *super;
  544.  
  545.         loose(p->p_got.t_obj);
  546.         this = T_NONE;
  547.         if ((d = new_struct()) == NULL)
  548.         goto fail;
  549.         super = NULL;
  550.         if (next(p, NULL) == T_COLON)
  551.         {
  552.         switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
  553.         {
  554.         case 0: not_followed_by("[struct :", an_expression);
  555.         case -1: goto fail;
  556.         }
  557.         loose(o);
  558.         if (!isstruct(o))
  559.         {
  560.             error = "the struct literal's super is not a struct";
  561.             goto fail;
  562.         }
  563.         super = structof(o);
  564.         switch (next(p, NULL))
  565.         {
  566.         case T_OFFSQUARE:
  567.             reject(p);
  568.         case T_COMMA:
  569.             break;
  570.  
  571.         default:
  572.             loose(super);
  573.             not_followed_by("[struct : expr", "\",\" or \"]\"");
  574.             goto fail;
  575.         }
  576.         }
  577.         else
  578.         reject(p);
  579.         for (;;)
  580.         {
  581.         switch (next(p, NULL))
  582.         {
  583.         case T_OFFSQUARE:
  584.             break;
  585.  
  586.         case T_ONROUND:
  587.             switch (const_expression(p, &o, t_prec(T_COMMA)))
  588.             {
  589.             case 0: not_followed_by("[struct ... (", an_expression);
  590.             case -1: loose(d); goto fail;
  591.             }
  592.             if (next(p, NULL) != T_OFFROUND)
  593.             {
  594.             not_followed_by("[struct ... (expr", "\")\"");
  595.             goto fail;
  596.             }
  597.             n = o;
  598.             goto gotkey;
  599.  
  600.         case T_NAME:
  601.             n = p->p_got.t_obj;
  602.         gotkey:
  603.             if (next(p, NULL) != T_EQ)
  604.             {
  605.             not_followed_by("[struct ... key", "\"=\"");
  606.             loose(d);
  607.             loose(n);
  608.             goto fail;
  609.             }
  610.             switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
  611.             {
  612.             case 0: not_followed_by("[struct ... ident =", an_expression);
  613.             case -1: goto fail;
  614.             }
  615.             if (assign(d, n, o))
  616.             goto fail;
  617.             loose(n);
  618.             loose(o);
  619.             switch (next(p, NULL))
  620.             {
  621.             case T_OFFSQUARE:
  622.             reject(p);
  623.             case T_COMMA:
  624.             continue;
  625.             }
  626.             not_followed_by("[struct ... key = expr", "\",\" or \"]\"");
  627.             loose(d);
  628.             goto fail;
  629.         }
  630.         break;
  631.         }
  632.         if ((d->s_super = super) != NULL)
  633.         loose(super);
  634.         e->e_what = T_CONST;
  635.         e->e_obj = objof(d);
  636.     }
  637.     else if (p->p_got.t_obj == objof(string_set))
  638.     {
  639.         loose(p->p_got.t_obj);
  640.         this = T_NONE;
  641.         if ((s = new_set()) == NULL)
  642.         goto fail;
  643.         for (;;)
  644.         {
  645.         switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
  646.         {
  647.         case -1: goto fail;
  648.         case 1:
  649.             if (assign(s, o, objof(o_one)))
  650.             {
  651.             loose(s);
  652.             goto fail;
  653.             }
  654.             loose(o);
  655.             if (next(p, NULL) == T_COMMA)
  656.             continue;
  657.             reject(p);
  658.             break;
  659.         }
  660.         break;
  661.         }
  662.         if (next(p, NULL) != T_OFFSQUARE)
  663.         {
  664.         loose(s);
  665.         not_followed_by("[set expr, expr ...", "\"]\"");
  666.         goto fail;
  667.         }
  668.         e->e_what = T_CONST;
  669.         e->e_obj = objof(s);
  670.     }
  671.     else if (p->p_got.t_obj == objof(string_func))
  672.     {
  673.         loose(p->p_got.t_obj);
  674.         this = T_NONE;
  675.         if ((n = objof(new_cname(""))) == NULL)
  676.         goto fail;
  677.         switch (function(p, stringof(n)))
  678.         {
  679.         case 0: not_followed_by("[func", "function body");
  680.         case -1:
  681.         loose(n);
  682.         goto fail;
  683.         }
  684.         loose(n);
  685.         e->e_what = T_CONST;
  686.         e->e_obj = p->p_got.t_obj;
  687.         if (next(p, NULL) != T_OFFSQUARE)
  688.         {
  689.         not_followed_by("[func function-body ", "\"]\"");
  690.         goto fail;
  691.         }
  692.     }
  693.     else
  694.     {
  695.         loose(p->p_got.t_obj);
  696.         not_followed_by("[", "\"array\", \"struct\", \"set\" or \"func\"");
  697.         goto fail;
  698.     }
  699.     break;
  700.  
  701.     default:
  702.     reject(p);
  703.     zfree((char *)e);
  704.     return 0;
  705.     }
  706.     *ep = e;
  707.     e = NULL;
  708.     for (;;)
  709.     {
  710.     switch (next(p, NULL))
  711.     {
  712.     case T_ONSQUARE:
  713.         if ((e = talloc(expr_t)) == NULL)
  714.         goto fail;
  715.         e->e_what = T_ONSQUARE;
  716.         e->e_arg[0] = *ep;
  717.         e->e_arg[1] = NULL;
  718.         e->e_obj = NULL;
  719.         *ep = e;
  720.         e = NULL;
  721.         switch (expr(p, &(*ep)->e_arg[1], t_prec(T_COMMA)))
  722.         {
  723.         case 0: not_followed_by("[", an_expression);
  724.         case -1: goto fail;
  725.         }
  726.         if (next(p, NULL) != T_OFFSQUARE)
  727.         {
  728.         not_followed_by("[ expr", "\"]\"");
  729.         goto fail;
  730.         }
  731.         break;
  732.         
  733.     case T_PTR:
  734.     case T_DOT:
  735.         if ((e = talloc(expr_t)) == NULL)
  736.         goto fail;
  737.         e->e_what = this;
  738.         e->e_arg[0] = *ep;
  739.         e->e_arg[1] = NULL;
  740.         e->e_obj = NULL;
  741.         *ep = e;
  742.         e = NULL;
  743.         switch (next(p, NULL))
  744.         {
  745.         case T_NAME:
  746.         if ((e = talloc(expr_t)) == NULL)
  747.             goto fail;
  748.         e->e_what = T_STRING;
  749.         e->e_arg[0] = NULL;
  750.         e->e_arg[1] = NULL;
  751.         e->e_obj = NULL;
  752.         e->e_obj = p->p_got.t_obj;
  753.         (*ep)->e_arg[1] = e;
  754.         e = NULL;
  755.         break;
  756.         
  757.         case T_ONROUND:
  758.         reject(p);
  759.         if (bracketed_expr(p, &(*ep)->e_arg[1]) < 1)
  760.             goto fail;
  761.         break;
  762.  
  763.         default:
  764.         not_followed_by(".", "an identifier or \"(\"");
  765.         goto fail;
  766.         }
  767.         break;
  768.  
  769.     case T_ONROUND:    /* Function call. */
  770.         if ((e = talloc(expr_t)) == NULL)
  771.         goto fail;
  772.         e->e_what = T_ONROUND;
  773.         e->e_arg[0] = *ep;
  774.         e->e_arg[1] = NULL;
  775.         e->e_obj = NULL;
  776.         *ep = e;
  777.         e = NULL;
  778.         for (;;)
  779.         {
  780.         expr_t    *e1;
  781.  
  782.         e1 = NULL;
  783.         switch (expr(p, &e1, t_prec(T_COMMA) - 1))
  784.         {
  785.         case -1:
  786.             goto fail;
  787.  
  788.         case 1:
  789.             if ((e = talloc(expr_t)) == NULL)
  790.             goto fail;
  791.             e->e_arg[1] = (*ep)->e_arg[1];
  792.             (*ep)->e_arg[1] = e;
  793.             e->e_what = T_COMMA;
  794.             e->e_arg[0] = e1;
  795.             e->e_obj = NULL;
  796.             e = NULL;
  797.             if (next(p, NULL) == T_COMMA)
  798.             continue;
  799.             reject(p);
  800.             break;
  801.         }
  802.         break;
  803.         }
  804.         if (next(p, NULL) != T_OFFROUND)
  805.         {
  806.         error = "error in function call arguments";
  807.         goto fail;
  808.         }
  809.         if (next(p, NULL) == T_ONCURLY)
  810.         {
  811.         /*
  812.          * Gratuitous check to get a better error message.
  813.          */
  814.         error = "function definition without a storage class";
  815.         goto fail;
  816.         }
  817.         reject(p);
  818.         break;
  819.  
  820.         
  821.     default:
  822.         reject(p);
  823.         return 1;
  824.     }
  825.     }
  826.  
  827. fail:
  828.     if (e != NULL)
  829.     {
  830.     if (e->e_obj != NULL)
  831.         loose(e->e_obj);
  832.     zfree((char *)e);
  833.     }
  834.     free_expr(*ep);
  835.     *ep = NULL;
  836.     return -1;
  837. }
  838.  
  839. STATIC int
  840. unary(p, ep)
  841. parse_t    *p;
  842. expr_t    **ep;
  843. {
  844.     expr_t    *e;
  845.     int        what;
  846.  
  847.     switch (next(p, NULL))
  848.     {
  849.     case T_ASTERIX:
  850.     case T_AND:
  851.     case T_MINUS:
  852.     case T_PLUS:
  853.     case T_EXCLAM:
  854.     case T_TILDE:
  855.     case T_PLUSPLUS:
  856.     case T_MINUSMINUS:
  857.     case T_AT:
  858.     case T_DOLLAR:
  859.     what = this;
  860.     switch (unary(p, ep))
  861.     {
  862.     case 0: error = "badly formed expression";
  863.     case -1: return -1;
  864.     }
  865.     if ((e = talloc(expr_t)) == NULL)
  866.         return -1;
  867.     e->e_what = what;
  868.     e->e_arg[0] = *ep;
  869.     e->e_arg[1] = NULL;
  870.     e->e_obj = NULL;
  871.     *ep = e;
  872.     break;
  873.  
  874.     default:
  875.     reject(p);
  876.     switch (primary(p, ep))
  877.     {
  878.     case 0: return 0;
  879.     case -1: return -1;
  880.     }
  881.     }
  882.     switch (next(p, NULL))
  883.     {
  884.     case T_PLUSPLUS:
  885.     case T_MINUSMINUS:
  886.     if ((e = talloc(expr_t)) == NULL)
  887.         return -1;
  888.     e->e_what = this;
  889.     e->e_arg[0] = NULL;
  890.     e->e_arg[1] = *ep;
  891.     e->e_obj = NULL;
  892.     *ep = e;
  893.     break;
  894.  
  895.     default:
  896.     reject(p);
  897.     break;
  898.     }
  899.     return 1;
  900. }
  901.  
  902. /*
  903.  * Parse an expression in the parse context 'p' and store the expression
  904.  * tree of 'expr_t' type nodes under the pointer indicated by 'ep'. All
  905.  * operators must be of precedence less than or equal to 'prec' (used to
  906.  * exclude comma operators in argument lists etc). Usual parseing return
  907.  * conventions (see comment near start of file).
  908.  */
  909. STATIC int
  910. expr(p, ep, prec)
  911. parse_t    *p;
  912. expr_t    **ep;
  913. int    prec;
  914. {
  915.     expr_t    *e;
  916.     expr_t    **ebase;
  917.     expr_t    *elimit;
  918.     int        tp;
  919.     int        r;
  920.  
  921.     /*
  922.      * This expression tree parser is neither state stack based nor recursive
  923.      * descent. It maintains an epression tree, and re-forms it each time
  924.      * it finds a subsequent binary operator and following factor. In
  925.      * practice this is probably faster than either the other two methods.
  926.      * It handles all the precedence and right/left associativity and
  927.      * the ? : operator correctly (at least according to ICI's definition
  928.      * of ? :).
  929.      */
  930.  
  931.     /*
  932.      * Get the first factor.
  933.      */
  934.     if ((r = unary(p, ebase = ep)) <= 0)
  935.     return r;
  936.     elimit = *ebase;
  937.  
  938.     /*
  939.      * While there is a following binary operator, merge it and the
  940.      * following factor into the expression.
  941.      */
  942.     while (t_type(next(p, NULL)) == T_BINOP && (tp = t_prec(this)) <= prec)
  943.     {
  944.     if (this == T_COLON)
  945.     {
  946.         /*
  947.          * Only allow colon after a ? so case labels terminate normally.
  948.          */
  949.         for (ep = ebase; (e = *ep) != elimit; ep = &e->e_arg[1])
  950.         {
  951.         if (e->e_what == T_QUESTION)
  952.             goto colon_is_ok_here;
  953.         }
  954.         break;
  955.     colon_is_ok_here:;
  956.     }
  957.  
  958.     /*
  959.      * Cause assignments to be right associative.
  960.      */
  961.     if (tp == t_prec(T_EQ))
  962.         --tp;
  963.  
  964.     /*
  965.      * Slide down the right hand side of the tree to find where this
  966.      * operator binds.
  967.      */
  968.     for
  969.     (
  970.         ep = ebase;
  971.         (e = *ep) != elimit && tp < t_prec(e->e_what);
  972.         ep = &e->e_arg[1]
  973.     )
  974.         ;
  975.  
  976.     /*
  977.      * Allocate a new node and rebuild this bit with the new operator
  978.      * and the following factor.
  979.      */
  980.     if ((e = talloc(expr_t)) == NULL)
  981.     {
  982.         zfree((char *)e);
  983.         return -1;
  984.     }
  985.     e->e_what = this;
  986.     e->e_arg[0] = *ep;
  987.     e->e_arg[1] = NULL;
  988.     e->e_obj = NULL;
  989.     switch (unary(p, &e->e_arg[1]))
  990.     {
  991.     case 0:
  992.         sprintf(buf, "\"expr %s\" %s %s",
  993.         ici_binop_name(t_subtype(e->e_what)), not_by, an_expression);
  994.         error = buf;
  995.     case -1:
  996.         zfree((char *)e);
  997.         return -1;
  998.     }
  999.     *ep = e;
  1000.     elimit = e->e_arg[1];
  1001.     }
  1002.     reject(p);
  1003.     return 1;
  1004. }
  1005.  
  1006. #ifdef    NOTDEF
  1007. /*
  1008.  * This code has been replaced by the function above. Which is more
  1009.  * optimal, just as simple and functionally equivalent.
  1010.  */
  1011. STATIC int
  1012. expr(p, ep, prec)
  1013. parse_t    *p;
  1014. expr_t    **ep;
  1015. int    prec;
  1016. {
  1017.     int        r;
  1018.     expr_t    *e;
  1019.  
  1020.     /*
  1021.      * This expression parseing is a bit nasty because it recursivly
  1022.      * climbs up and down all the precedence levels for every primary
  1023.      * expression.  It could be changed to skip around more optimally.
  1024.      * Mind you, it's probably the smallest C expression parser you
  1025.      * have ever seen.  It handles all the precedence and right/left
  1026.      * associativity and the ? : operator correctly.
  1027.      */
  1028.     if (prec < 0)
  1029.     return unary(p, ep);
  1030.     /*
  1031.      * T_QUESTION stuff in 2nd arg invalidates colon in normal positions.
  1032.      * You need this because in 'case' statements colon must terminate
  1033.      * the expression.
  1034.      */
  1035.     if ((r = expr(p, ep, prec - 1 - (prec == t_prec(T_QUESTION)))) < 1)
  1036.     return r;
  1037.     for (;;)
  1038.     {
  1039.     if (t_type(next(p, NULL)) != T_BINOP || t_prec(this) != prec)
  1040.     {
  1041.         reject(p);
  1042.         return 1;
  1043.     }
  1044.     if ((e = talloc(expr_t)) == NULL)
  1045.     {
  1046.         free_expr(*ep);
  1047.         return -1;
  1048.     }
  1049.     e->e_what = this;
  1050.     e->e_arg[0] = *ep;
  1051.     e->e_arg[1] = NULL;
  1052.     e->e_obj = NULL;
  1053.     *ep = e;
  1054.     /*
  1055.      * The t_prec() stuff in 2nd argument causes right associativity.
  1056.      * (The assignment and question-colon operators are right associative,
  1057.      * everything else is left.)
  1058.      */
  1059.     r = this;
  1060.     switch (expr(p, &e->e_arg[1], prec - (t_prec(this) != t_prec(T_EQ)
  1061.                     + 2 * (t_prec(this) == t_prec(T_COLON)))))
  1062.     {
  1063.     case 0:
  1064.         sprintf(buf, "\"expr %s\" %s %s",
  1065.         ici_binop_name(t_subtype(r)), not_by, an_expression);
  1066.         error = buf;
  1067.     case -1:
  1068.         return -1;
  1069.     }
  1070.     }
  1071. }
  1072. #endif
  1073.  
  1074. STATIC int
  1075. expression(p, a, why, prec)
  1076. parse_t    *p;
  1077. array_t    *a;
  1078. int    why;
  1079. int    prec;
  1080. {
  1081.     expr_t    *e;
  1082.  
  1083.     e = NULL;
  1084.     switch (expr(p, &e, prec))
  1085.     {
  1086.     case 0: return 0;
  1087.     case -1: goto fail;
  1088.     }
  1089.     if (compile_expr(a, e, why) == -1)
  1090.     goto fail;
  1091.     free_expr(e);
  1092.     return 1;
  1093.  
  1094. fail:
  1095.     free_expr(e);
  1096.     return -1;
  1097. }
  1098.  
  1099. STATIC int
  1100. const_expression(p, po, prec)
  1101. parse_t        *p;
  1102. object_t    **po;
  1103. int        prec;
  1104. {
  1105.     expr_t    *e;
  1106.     array_t    *a;
  1107.     int        ret;
  1108.  
  1109.     a = NULL;
  1110.     e = NULL;
  1111.     if ((ret = expr(p, &e, prec)) <= 0)
  1112.     return ret;
  1113.     if ((a = new_array()) == NULL)
  1114.     goto fail;
  1115.     if (compile_expr(a, e, FOR_VALUE) == -1)
  1116.     goto fail;
  1117.     free_expr(e);
  1118.     e = NULL;
  1119.     if ((*po = ici_evaluate(objof(a), NULL)) == NULL)
  1120.     goto fail;
  1121.     loose(a);
  1122.     return 1;
  1123.  
  1124. fail:
  1125.     if (a != NULL)
  1126.     loose(a);
  1127.     free_expr(e);
  1128.     return -1;
  1129. }
  1130.  
  1131. STATIC int
  1132. xx_brac_expr_brac(p, a, xx)
  1133. parse_t    *p;
  1134. array_t    *a;
  1135. char    *xx;
  1136. {
  1137.     if (next(p, a) != T_ONROUND)
  1138.     {
  1139.     sprintf(buf, "\"%s\" %s a \"(\"", xx, not_by);
  1140.     goto fail;
  1141.     }
  1142.     switch (expression(p, a, FOR_VALUE, t_prec(T_COMMA)))
  1143.     {
  1144.     case 0:
  1145.     sprintf(buf, "\"%s (\" %s %s", xx, not_by, an_expression);
  1146.     goto fail;
  1147.     
  1148.     case -1:
  1149.     return -1;
  1150.     }
  1151.     if (next(p, a) != T_OFFROUND)
  1152.     {
  1153.     sprintf(buf, "\"%s (expr\" %s \")\"", xx, not_by);
  1154.     goto fail;
  1155.     }
  1156.     return 1;
  1157.  
  1158. fail:
  1159.     error = buf;
  1160.     return -1;
  1161. }
  1162.  
  1163. STATIC int
  1164. statement(p, a, sw, m)
  1165. parse_t        *p;
  1166. array_t        *a;    /* Code array being appended to. */
  1167. struct_t    *sw;    /* Switch structure, else NULL. */
  1168. char        *m;    /* Who needs it, else NULL. */
  1169. {
  1170.     array_t    *a1;
  1171.     array_t    *a2;
  1172.     object_t    **op;
  1173.     expr_t    *e;
  1174.     struct_t    *d;
  1175.     object_t    *o;
  1176.     int_t    *i;
  1177.     int        stepz;
  1178.  
  1179.     switch (next(p, a))
  1180.     {
  1181.     case T_ONCURLY:
  1182.     reject(p);
  1183.     if (compound_statement(p, NULL) == -1)
  1184.         return -1;
  1185.     a1 = arrayof(p->p_got.t_obj);
  1186.     /*
  1187.      * Perhaps we shouldn't expand the statement in-line like this.
  1188.      * People may want to be able to take advantage of the sharing
  1189.      * that might otherwise happen.
  1190.      */
  1191.     if (pushcheck(a, a1->a_top - a1->a_base))
  1192.         return -1;
  1193.     for (op = a1->a_base; op < a1->a_top; ++op)
  1194.         *a->a_top++ = *op;
  1195.     loose(a1);
  1196.     break;
  1197.  
  1198.     case T_SEMICOLON:
  1199.     break;
  1200.  
  1201.     case T_OFFCURLY: /* Just to prevent unecessary expression parseing. */
  1202.     case T_EOF:
  1203.     case T_ERROR:
  1204.     reject(p);
  1205.     goto none;
  1206.  
  1207.     case T_NAME:
  1208.     if (p->p_got.t_obj == objof(string_extern))
  1209.     {
  1210.         loose(p->p_got.t_obj);
  1211.         if
  1212.         (
  1213.         (d = structof(v_top[-1])->s_super) == NULL
  1214.         ||
  1215.         (d = d->s_super) == NULL
  1216.         )
  1217.         {
  1218.         error = "extern declaration, but no extern variable scope";
  1219.         return -1;
  1220.         }
  1221.         goto decl;
  1222.     }
  1223.     if (p->p_got.t_obj == objof(string_static))
  1224.     {
  1225.         loose(p->p_got.t_obj);
  1226.         if ((d = structof(v_top[-1])->s_super) == NULL)
  1227.         {
  1228.         error = "static declaration, but no static variable scope";
  1229.         return -1;
  1230.         }
  1231.         goto decl;
  1232.     }
  1233.     if (p->p_got.t_obj == objof(string_auto))
  1234.     {
  1235.         loose(p->p_got.t_obj);
  1236.         if (p->p_func == NULL)
  1237.         d = structof(v_top[-1]);
  1238.         else
  1239.         d = p->p_func->f_autos;
  1240.     decl:
  1241.         if (data_def(p, d) == -1)
  1242.         return -1;
  1243.         break;
  1244.     }
  1245.     if (p->p_got.t_obj == objof(string_case))
  1246.     {
  1247.         loose(p->p_got.t_obj);
  1248.         if (sw == NULL)
  1249.         {
  1250.         error = "\"case\" not at top level of switch body";
  1251.         return -1;
  1252.         }
  1253.         switch (const_expression(p, &o, t_prec(T_COMMA)))
  1254.         {
  1255.         case 0: not_followed_by("case", an_expression);
  1256.         case -1: return -1;
  1257.         }
  1258.         if ((i = new_int((long)(a->a_top - a->a_base))) == NULL)
  1259.         {
  1260.         loose(o);
  1261.         return -1;
  1262.         }
  1263.         if (assign(sw, o, i))
  1264.         {
  1265.         loose(i);
  1266.         loose(o);
  1267.         return -1;
  1268.         }
  1269.         loose(i);
  1270.         loose(o);
  1271.         if (next(p, a) != T_COLON)
  1272.         return not_followed_by("case expr", "\":\"");
  1273.         break;
  1274.     }
  1275.     if (p->p_got.t_obj == objof(string_default))
  1276.     {
  1277.         loose(p->p_got.t_obj);
  1278.         if (sw == NULL)
  1279.         {
  1280.         error = "\"default\" not at top level of switch body";
  1281.         return -1;
  1282.         }
  1283.         if (next(p, a) != T_COLON)
  1284.         return not_followed_by("default", "\":\"");
  1285.         if ((i = new_int((long)(a->a_top - a->a_base))) == NULL)
  1286.         return -1;
  1287.         if (assign(sw, objof(&o_mark), i))
  1288.         {
  1289.         loose(i);
  1290.         return -1;
  1291.         }
  1292.         loose(i);
  1293.         break;
  1294.     }
  1295.     if (p->p_got.t_obj == objof(string_if))
  1296.     {
  1297.         loose(p->p_got.t_obj);
  1298.         if (xx_brac_expr_brac(p, a, "if") != 1)
  1299.         return -1;
  1300.         if ((a1 = new_array()) == NULL)
  1301.         return -1;
  1302.         if (statement(p, a1, NULL, "if (expr)") == -1)
  1303.         {
  1304.         loose(a1);
  1305.         return -1;
  1306.         }
  1307.         a2 = NULL;
  1308.         if (next(p, a) == T_NAME && p->p_got.t_obj == objof(string_else))
  1309.         {
  1310.         loose(p->p_got.t_obj);
  1311.         if ((a2 = new_array()) == NULL)
  1312.             return -1;
  1313.         if (statement(p, a2, NULL, "if (expr) stmt else") == -1)
  1314.             return -1;
  1315.         }
  1316.         else
  1317.         reject(p);
  1318.         if (pushcheck(a, 3))
  1319.         return -1;
  1320.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  1321.         loose(a1);
  1322.         if (a2 != NULL)
  1323.         {
  1324.         *a->a_top++ = objof(a2 = (array_t *)atom(objof(a2), 1));
  1325.         loose(a2);
  1326.         *a->a_top++ = objof(&o_ifelse);
  1327.         }
  1328.         else
  1329.         *a->a_top++ = objof(&o_if);
  1330.         break;
  1331.  
  1332.     }
  1333.     if (p->p_got.t_obj == objof(string_while))
  1334.     {
  1335.         loose(p->p_got.t_obj);
  1336.         if ((a1 = new_array()) == NULL)
  1337.         return -1;
  1338.         if (xx_brac_expr_brac(p, a1, "while") != 1)
  1339.         {
  1340.         loose(a1);
  1341.         return -1;
  1342.         }
  1343.         if (pushcheck(a1, 1))
  1344.         {
  1345.         loose(a1);
  1346.         return -1;
  1347.         }
  1348. /*### Up to here in checking loose() use. */
  1349.         *a1->a_top++ = objof(&o_ifnotbreak);
  1350.         if (statement(p, a1, NULL, "while (expr)") == -1)
  1351.         return -1;
  1352.         if (pushcheck(a, 2))
  1353.         return -1;
  1354.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  1355.         loose(a1);
  1356.         *a->a_top++ = objof(&o_loop);
  1357.         break;
  1358.  
  1359.     }
  1360.     if (p->p_got.t_obj == objof(string_do))
  1361.     {
  1362.         loose(p->p_got.t_obj);
  1363.         if ((a1 = new_array()) == NULL)
  1364.         return -1;
  1365.         if (statement(p, a1, NULL, "do") == -1)
  1366.         return -1;
  1367.         if (next(p, a1) != T_NAME || p->p_got.t_obj != objof(string_while))
  1368.         return not_followed_by("do statement", "\"while\"");
  1369.         loose(p->p_got.t_obj);
  1370.         if (next(p, NULL) != T_ONROUND)
  1371.         return not_followed_by("do statement while", "\"(\"");
  1372.         switch (expression(p, a1, FOR_VALUE, t_prec(T_COMMA)))
  1373.         {
  1374.         case 0: error = "syntax error";
  1375.         case -1: loose(a1); return -1;
  1376.         }
  1377.         if (next(p, a1) != T_OFFROUND || next(p, NULL) != T_SEMICOLON)
  1378.         {
  1379.         loose(a1);
  1380.         return not_followed_by("do statement while (expr", "\");\"");
  1381.         }
  1382.         if (pushcheck(a1, 1))
  1383.         return -1;
  1384.         *a1->a_top++ = objof(&o_ifnotbreak);
  1385.  
  1386.         if (pushcheck(a, 2))
  1387.         return -1;
  1388.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  1389.         loose(a1);
  1390.         *a->a_top++ = objof(&o_loop);
  1391.         break;
  1392.     }
  1393.     if (p->p_got.t_obj == objof(string_forall))
  1394.     {
  1395.         loose(p->p_got.t_obj);
  1396.         if (next(p, a) != T_ONROUND)
  1397.         return not_followed_by("forall", "\"(\"");
  1398.         if (expression(p, a, FOR_LVALUE, t_prec(T_COMMA) - 1) == -1)
  1399.         return -1;
  1400.         if (next(p, a) == T_COMMA)
  1401.         {
  1402.         if (expression(p, a, FOR_LVALUE, t_prec(T_COMMA) - 1) == -1)
  1403.             return -1;
  1404.         if (next(p, a) != T_NAME || p->p_got.t_obj != objof(string_in))
  1405.             return not_followed_by("forall (expr, expr", "\"in\"");
  1406.         loose(p->p_got.t_obj);
  1407.         }
  1408.         else
  1409.         {
  1410.         if (this != T_NAME || p->p_got.t_obj != objof(string_in))
  1411.             return not_followed_by("forall (expr", "\",\" or \"in\"");
  1412.         loose(p->p_got.t_obj);
  1413.         if (pushcheck(a, 2))
  1414.             return -1;
  1415.         *a->a_top++ = objof(&o_null);
  1416.         *a->a_top++ = objof(&o_null);
  1417.         }
  1418.         if (expression(p, a, FOR_VALUE, t_prec(T_COMMA)) == -1)
  1419.         return -1;
  1420.         if (next(p, a) != T_OFFROUND)
  1421.         return not_followed_by("forall (expr [, expr] in expr", "\")\"");
  1422.         if ((a1 = new_array()) == NULL)
  1423.         return -1;
  1424.         if (statement(p, a1, NULL, "forall (expr [, expr] in expr)") == -1)
  1425.         return -1;
  1426.         if (pushcheck(a, 2))
  1427.         return -1;
  1428.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  1429.         loose(a1);
  1430.         if ((*a->a_top = objof(new_op(op_forall, 0, 0))) == NULL)
  1431.         return -1;
  1432.         loose(*a->a_top);
  1433.         ++a->a_top;
  1434.         break;
  1435.  
  1436.     }
  1437.     if (p->p_got.t_obj == objof(string_for))
  1438.     {
  1439.         loose(p->p_got.t_obj);
  1440.         if (next(p, a) != T_ONROUND)
  1441.         return not_followed_by("for", "\"(\"");
  1442.         if (expression(p, a, FOR_EFFECT, t_prec(T_COMMA)) == -1)
  1443.         return -1;
  1444.         if (next(p, a) != T_SEMICOLON)
  1445.         return not_followed_by("for (expr", "\";\"");
  1446.  
  1447.         /*
  1448.          * Get the condition expression, but don't generate code yet.
  1449.          */
  1450.         e = NULL;
  1451.         if (expr(p, &e, t_prec(T_COMMA)) == -1)
  1452.         return -1;
  1453.  
  1454.         if (next(p, a) != T_SEMICOLON)
  1455.         return not_followed_by("for (expr; expr", "\";\"");
  1456.  
  1457.         /*
  1458.          * a1 is the body of the loop.  Get the step expression.
  1459.          */
  1460.         if ((a1 = new_array()) == NULL)
  1461.         return -1;
  1462.         if (expression(p, a1, FOR_EFFECT, t_prec(T_COMMA)) == -1)
  1463.         return -1;
  1464.         stepz = a1->a_top - a1->a_base;
  1465.  
  1466.         if (e != NULL)
  1467.         {
  1468.         /*
  1469.          * Now compile in the test expression.
  1470.          */
  1471.         if (compile_expr(a1, e, FOR_VALUE) == -1)
  1472.         {
  1473.             free_expr(e);
  1474.             return -1;
  1475.         }
  1476.         free_expr(e);
  1477.         if (pushcheck(a1, 1))
  1478.             return -1;
  1479.         *a1->a_top++ = objof(&o_ifnotbreak);
  1480.         }
  1481.         if (next(p, a1) != T_OFFROUND)
  1482.         return not_followed_by("for (expr; expr; expr", "\")\"");
  1483.         if (statement(p, a1, NULL, "for (expr; expr; expr)") == -1)
  1484.         return -1;
  1485.         if (pushcheck(a, 2))
  1486.         return -1;
  1487.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  1488.         loose(a1);
  1489.         if ((*a->a_top = objof(new_op(op_for, 0, stepz))) == NULL)
  1490.         return -1;
  1491.         loose(*a->a_top);
  1492.         ++a->a_top;
  1493.         break;
  1494.  
  1495.     }
  1496.     if (p->p_got.t_obj == objof(string_switch))
  1497.     {
  1498.         loose(p->p_got.t_obj);
  1499.         if (xx_brac_expr_brac(p, a, "switch") != 1)
  1500.         return -1;
  1501.         if ((d = new_struct()) == NULL)
  1502.         return -1;
  1503.         switch (compound_statement(p, d))
  1504.         {
  1505.         case 0: not_followed_by("switch (expr)", "a compound statement");
  1506.         case -1: return -1;
  1507.         }
  1508.         if (pushcheck(a, 3))
  1509.         return -1;
  1510.         *a->a_top++ = p->p_got.t_obj;
  1511.         loose(p->p_got.t_obj);
  1512.         *a->a_top++ = objof(d = (struct_t *)atom(objof(d), 1));
  1513.         *a->a_top++ = objof(&o_switch);
  1514.         loose(d);
  1515.         break;
  1516.     }
  1517.     if (p->p_got.t_obj == objof(string_break))
  1518.     {
  1519.         loose(p->p_got.t_obj);
  1520.         if (next(p, a) != T_SEMICOLON)
  1521.         return not_followed_by("break", "\";\"");
  1522.         if (pushcheck(a, 1))
  1523.         return -1;
  1524.         *a->a_top++ = objof(&o_break);
  1525.         break;
  1526.  
  1527.     }
  1528.     if (p->p_got.t_obj == objof(string_continue))
  1529.     {
  1530.         loose(p->p_got.t_obj);
  1531.         if (next(p, a) != T_SEMICOLON)
  1532.         return not_followed_by("continue", "\";\"");
  1533.         if (pushcheck(a, 1))
  1534.         return -1;
  1535.         *a->a_top++ = objof(&o_continue);
  1536.         break;
  1537.     }
  1538.     if (p->p_got.t_obj == objof(string_return))
  1539.     {
  1540.         loose(p->p_got.t_obj);
  1541.         switch (expression(p, a, FOR_VALUE, t_prec(T_COMMA)))
  1542.         {
  1543.         case -1: return -1;
  1544.         case 0:
  1545.         if (pushcheck(a, 1))
  1546.             return -1;
  1547.         if ((*a->a_top = objof(&o_null)) == NULL)
  1548.             return -1;
  1549.         ++a->a_top;
  1550.         }
  1551.         if (next(p, a) != T_SEMICOLON)
  1552.         return not_followed_by("return [expr]", "\";\"");
  1553.         if (pushcheck(a, 1))
  1554.         return -1;
  1555.         *a->a_top++ = objof(&o_return);
  1556.         break;
  1557.     }
  1558.     if (p->p_got.t_obj == objof(string_try))
  1559.     {
  1560.         loose(p->p_got.t_obj);
  1561.         if ((a1 = new_array()) == NULL)
  1562.         return -1;
  1563.         if (statement(p, a1, NULL, "try") == -1)
  1564.         return -1;
  1565.         if (next(p, a1) != T_NAME || p->p_got.t_obj != objof(string_onerror))
  1566.         return not_followed_by("try statement", "\"onerror\"");
  1567.         loose(p->p_got.t_obj);
  1568.         if ((a2 = new_array()) == NULL)
  1569.         return -1;
  1570.         if (statement(p, a2, NULL, "try statement onerror") == -1)
  1571.         return -1;
  1572.         if (pushcheck(a, 3))
  1573.         return -1;
  1574.         *a->a_top++ = objof(a1);
  1575.         *a->a_top++ = objof(a2);
  1576.         *a->a_top++ = objof(&o_onerror);
  1577.         loose(a1);
  1578.         loose(a2);
  1579.         break;
  1580.     }
  1581.     default:
  1582.     reject(p);
  1583.     switch (expression(p, a, FOR_EFFECT, t_prec(T_COMMA)))
  1584.     {
  1585.     case 0: goto none;
  1586.     case -1: return -1;
  1587.     }
  1588.     if (next(p, a) != T_SEMICOLON)
  1589.     {
  1590.         error = "badly formed expression, or missing \";\"";
  1591.         return -1;
  1592.     }
  1593.     break;
  1594.     }
  1595.     return 1;
  1596.  
  1597. none:
  1598.     if (m != NULL)
  1599.     {
  1600.     sprintf(buf, "\"%s\" %s a reasonable statement", m, not_by);
  1601.     return -1;
  1602.     }
  1603.     return 0;
  1604. }
  1605.  
  1606. int
  1607. parse_module(f, s)
  1608. file_t        *f;
  1609. struct_t    *s;    /* Scope; autos, statics, externs. */
  1610. {
  1611.     parse_t        *p;
  1612.     object_t        *o;
  1613.  
  1614.     if ((p = new_parse(f)) == NULL)
  1615.     return -1;
  1616.  
  1617.     *v_top++ = objof(s);
  1618.     NEXT_VSVER;
  1619.     if ((o = ici_evaluate(objof(p), NULL)) == NULL)
  1620.     {
  1621.     --v_top;
  1622.     NEXT_VSVER;
  1623.     loose(p);
  1624.     return -1;
  1625.     }
  1626.     --v_top;
  1627.     NEXT_VSVER;
  1628.     loose(o);
  1629.     loose(p);
  1630.     return 0;
  1631. }
  1632.  
  1633. /*
  1634.  * Parse the given file, module file name 'mname'.  Return 0 if ok, else -1,
  1635.  * usual conventions.  It closes the file (if all goes well).
  1636.  */
  1637. int
  1638. parse_file(mname, file, ftype)
  1639. char    *mname;
  1640. char    *file;
  1641. ftype_t    *ftype;
  1642. {
  1643.     struct_t    *s;    /* Statics. */
  1644.     struct_t    *a;    /* Autos. */
  1645.     file_t    *f;
  1646.  
  1647.     a = NULL;
  1648.     f = NULL;
  1649.     if ((f = new_file(file, ftype, get_cname(mname))) == NULL)
  1650.     goto fail;
  1651.  
  1652.     if ((a = new_struct()) == NULL)
  1653.     goto fail;
  1654.     if ((a->s_super = s = new_struct()) == NULL)
  1655.     goto fail;
  1656.     loose(s);
  1657.     s->s_super = structof(v_top[-1])->s_super;
  1658.  
  1659.     if (parse_module(f, a) < 0)
  1660.     goto fail;
  1661.     f_close(f);
  1662.     loose(a);
  1663.     loose(f);
  1664.     return 0;
  1665.  
  1666. fail:
  1667.     if (f != NULL)
  1668.     loose(f);
  1669.     if (a != NULL)
  1670.     loose(a);
  1671.     return -1;
  1672. }
  1673.  
  1674. STATIC long
  1675. mark_parse(p)
  1676. register parse_t    *p;
  1677. {
  1678.     long    mem;
  1679.  
  1680.     objof(p)->o_flags |= O_MARK;
  1681.     mem = sizeof(parse_t);
  1682.     if (p->p_func != NULL)
  1683.     mem += mark(p->p_func);
  1684.     if (p->p_file != NULL)
  1685.     mem += mark(p->p_file);
  1686.     return mem;
  1687. }
  1688.  
  1689. int
  1690. parse_exec()
  1691. {
  1692.     parse_t    *p;
  1693.     array_t    *a;
  1694.  
  1695.     if ((a = new_array()) == NULL)
  1696.     return 1;
  1697.  
  1698.     p = parseof(x_top[-1]);
  1699.  
  1700.     for (;;)
  1701.     {
  1702.     switch (statement(p, a, NULL, NULL))
  1703.     {
  1704.     case 1:
  1705.         if (a->a_top == a->a_base)
  1706.         continue;
  1707.         if ((*x_top = objof(new_pc(a))) == NULL)
  1708.         {
  1709.         loose(a);
  1710.         return 1;
  1711.         }
  1712.         ++x_top;
  1713.         loose(a);
  1714.         return 0;
  1715.  
  1716.     case 0:
  1717.         if (next(p, a) == T_EOF)
  1718.         {
  1719.         --x_top;
  1720.         loose(a);
  1721.         return 0;
  1722.         }
  1723.         error = "syntax error";
  1724.     default:
  1725.         loose(a);
  1726.         if (this == T_ERROR)
  1727.         error = p->p_got.t_str;
  1728.         expand_error(p->p_lineno, p->p_file->f_name);
  1729.         return 1;
  1730.     }
  1731.     }
  1732. }
  1733.  
  1734. parse_t *
  1735. new_parse(f)
  1736. file_t        *f;
  1737. {
  1738.     register parse_t    *p;
  1739.  
  1740.     if ((p = (parse_t *)talloc(parse_t)) == NULL)
  1741.     return NULL;
  1742.     memset(p, 0, sizeof(parse_t));
  1743.     objof(p)->o_type = &parse_type;
  1744.     objof(p)->o_tcode = TC_PARSE;
  1745.     objof(p)->o_flags = 0;
  1746.     objof(p)->o_nrefs = 1;
  1747.     rego(p);
  1748.     p->p_file = f;
  1749.     p->p_sol = 1;
  1750.     p->p_lineno = 1;
  1751.     p->p_func = NULL;
  1752.     p->p_ungot.t_what = T_NONE;
  1753.     return p;
  1754. }
  1755.  
  1756. type_t    parse_type =
  1757. {
  1758.     mark_parse,
  1759.     free_simple,
  1760.     hash_unique,
  1761.     cmp_unique,
  1762.     copy_simple,
  1763.     assign_simple,
  1764.     fetch_simple,
  1765.     "parse"
  1766. };
  1767.